home *** CD-ROM | disk | FTP | other *** search
/ MacWorld 1998 March / Macworld (1998-03) (Disk 1).dmg / Shareware World / Utilities / Text Processing / Alpha / Tcl / Modes / setextMode.tcl < prev    next >
Encoding:
Text File  |  1997-10-08  |  1.3 KB  |  48 lines  |  [TEXT/ALFA]
  1. #################################################################################
  2. # Setext file support
  3. #
  4. # Recognize and automatically mark 'setext'-encoded text files, like Tidbits.
  5. #
  6. # (Tom Pollard - October 1994)
  7. #
  8. #================================================================================
  9.  
  10.  
  11. alpha::mode Setx 1.0 dummySetx {*.stx *.etx} 
  12.  
  13. #===============================================================================
  14.  
  15.  
  16.  
  17. newPref f autoMark 1 Setx
  18. #=============================================================================
  19. proc dummySetx {} {}
  20.  
  21. proc Setx::MarkFile {} {
  22.     set pat1 {^(-+|=+)$}
  23.     set end [maxPos]
  24.     set pos 0
  25.     set l {}
  26.     while {![catch {search -s -f 1 -r 1 -m 0 -i 1 $pat1 $pos} mtch]} {
  27.         set pos1 [lineStart [expr [lindex $mtch 0] - 1]]
  28.         set marker [string trimright [eval getText $mtch]]
  29.         set text [string trimright [getText $pos1 [nextLineStart $pos1]]]
  30.         if {[string length $text] == [string length $marker]} {
  31.             if {[string range $marker 0 0] == "-"} {
  32.                 set text "     $text"
  33.             }
  34.             regsub {/} $text {-} text
  35.             set inds($text) $pos1
  36.             lappend sects $text
  37.         }
  38.         set pos [nextLineStart [lindex $mtch 1]]
  39.     }
  40.  
  41.     if {[info exists inds]} {
  42.         foreach f $sects {
  43.             set next [lineStart $inds($f)]
  44.             setNamedMark $f $inds($f) $next $next
  45.         }
  46.     }
  47. }
  48.